home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue27 / tiptrix / listing3.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-10-13  |  1.4 KB  |  49 lines
  1. unit FilteredComponentProperty;
  2. interface
  3. uses  Classes, DsgnIntf ;
  4. type
  5.   TTestCompAbs = class( TComponent ) ;
  6.   TTestComp = class( TTestCompAbs )
  7.   private
  8.     FParentComp : TTestCompAbs ;
  9.   published
  10.     property ParentComp : TTestCompAbs read FParentComp write FParentComp ;
  11.   end ;
  12.   TFilteredComponentProperty = class( TComponentProperty )
  13.   private
  14.     FInheritedProc : TGetStrProc ;
  15.     procedure OurProc( const s : string ) ;
  16.     function  IsOurName( const s : string ) : boolean ;
  17.   protected
  18.     procedure GetValues( Proc : TGetStrProc ) ; override ;
  19.   end ;
  20. procedure Register ;
  21. implementation
  22. function  TFilteredComponentProperty.IsOurName( const s : string ) : 
  23. boolean ;
  24. var i : integer ;
  25. begin
  26.   Result := true ;
  27.   for i := 0 to PropCount - 1 do
  28.     if s = ( GetComponent( i ) as TComponent ).Name then exit ;
  29.   Result := false ;
  30. end ;
  31. procedure TFilteredComponentProperty.OurProc( const s : string ) ;
  32. begin
  33.   // only pass on if value is not our own name
  34.   if not IsOurName( s ) then
  35.     FInheritedProc( s ) ;
  36. end ;
  37. procedure TFilteredComponentProperty.GetValues( Proc : TGetStrProc ) ;
  38. begin
  39.   FInheritedProc := Proc ;
  40.   inherited GetValues( OurProc ) ;
  41. end;
  42. procedure Register ;
  43. begin
  44.   RegisterComponents( 'Samples', [ TTestComp ] ) ;
  45.   RegisterPropertyEditor( TypeInfo( TTestCompAbs ), TTestCompAbs, '',
  46.                           TFilteredComponentProperty ) ;
  47. end ;
  48. end.
  49.